home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbconvm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-16  |  8.0 KB  |  283 lines
  1. (*===========================================================================*)
  2. (* Miscellaneous things for converse mode                                    *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. {$O+}
  13.  
  14. {$DEFINE POINT_CHK}
  15. {$DEFINE FREE_CHK}
  16.  
  17. UNIT BBCONVM;
  18.  
  19. INTERFACE
  20.  
  21. USES
  22.   bbdummy;
  23.  
  24. PROCEDURE add_c_string(to_tcb : tcb_ptr; in_str : str_ptr; in_type : BYTE);
  25.  
  26. PROCEDURE add_c_long  (to_tcb : tcb_ptr; in_sm  : str_mixed_ptr);
  27.  
  28. PROCEDURE add_c_ub    (to_tcb : tcb_ptr; in_place : POINTER; in_cnt : WORD);
  29.  
  30. PROCEDURE del_c_string(this_tcb : tcb_ptr);
  31.  
  32. PROCEDURE drop_conv   (this_tcb : tcb_ptr);
  33.  
  34. IMPLEMENTATION
  35.  
  36. USES
  37.   bbmisc3;
  38.  
  39. (*===========================================================================*)
  40. (* Internal subroutine to add something to the chain                         *)
  41. (*===========================================================================*)
  42.  
  43. PROCEDURE add_c_chain (to_tcb : tcb_ptr; in_scb : str_m_chain);
  44.  
  45.   VAR
  46.     last_scb    : str_m_chain;
  47.  
  48.   BEGIN;
  49.  
  50.     {$IFDEF DEBUG}
  51.       WRITELN('Chain add from ', active_tcb^.port_chan_s, ' to ',
  52.                                                            to_tcb^.port_chan_s);
  53.       WRITELN('data=', LENGTH(in_scb^.str_m_data.str_data), '=',
  54.                                                    in_scb^.str_m_data.str_data);
  55.     {$ENDIF}
  56.  
  57.     {$IFDEF POINT_CHK}
  58.       test_pointer(to_tcb);
  59.       test_pointer(in_scb);
  60.     {$ENDIF}
  61.  
  62.     in_scb^.str_m_next := NIL;
  63.  
  64.     last_scb := to_tcb^.c_input;
  65.     IF last_scb <> NIL THEN
  66.       BEGIN;
  67.  
  68.         {$IFDEF POINT_CHK}
  69.           test_pointer(last_scb);
  70.         {$ENDIF}
  71.  
  72.         WHILE last_scb^.str_m_next <> NIL DO
  73.           BEGIN;
  74.             {$IFDEF POINT_CHK}
  75.               test_pointer(last_scb);
  76.             {$ENDIF}
  77.             last_scb := last_scb^.str_m_next;
  78.           END;
  79.  
  80.         {$IFDEF POINT_CHK}
  81.           test_pointer(last_scb);
  82.         {$ENDIF}
  83.  
  84.         last_scb^.str_m_next := in_scb;
  85.  
  86.       END
  87.     ELSE
  88.       to_tcb^.c_input := in_scb;
  89.  
  90.   END;
  91.  
  92. (*===========================================================================*)
  93. (* Add string to converse tasks' input chains                                *)
  94. (*===========================================================================*)
  95.  
  96. PROCEDURE add_c_long  (to_tcb : tcb_ptr; in_sm  : str_mixed_ptr);
  97.  
  98.   VAR
  99.     i           : WORD;
  100.     work_scb    : str_m_chain;
  101.  
  102.   BEGIN;
  103.  
  104.     {$IFDEF POINT_CHK}
  105.       test_pointer(to_tcb);
  106.       test_pointer(in_sm);
  107.     {$ENDIF}
  108.  
  109.     i := in_sm^.long_length + str_m_block_oh;
  110.     GETMEM(work_scb, i);
  111.  
  112.     MOVE(in_sm^, work_scb^.str_m_data, str_m_oh + in_sm^.long_length);
  113.     work_scb^.str_m_type := 1;
  114.  
  115.     add_c_chain(to_tcb, work_scb);
  116.  
  117.   END;
  118.  
  119. (*===========================================================================*)
  120. (* Add string to converse tasks' input chains                                *)
  121. (*===========================================================================*)
  122.  
  123. PROCEDURE add_c_string(to_tcb : tcb_ptr; in_str : str_ptr; in_type : BYTE);
  124.  
  125.   VAR
  126.     i           : WORD;
  127.     work_scb    : str_m_chain;
  128.  
  129.   BEGIN;
  130.  
  131.     {$IFDEF POINT_CHK}
  132.       test_pointer(to_tcb);
  133.       test_pointer(in_str);
  134.     {$ENDIF}
  135.  
  136.     i := LENGTH(in_str^) + str_m_block_oh;
  137.     GETMEM(work_scb, i);
  138.  
  139.     work_scb^.str_m_data.str_data    := in_str^;
  140.     work_scb^.str_m_data.long_length := LENGTH(in_str^);
  141.     work_scb^.str_m_type             := in_type;
  142.  
  143.     add_c_chain(to_tcb, work_scb);
  144.  
  145.   END;
  146.  
  147. (*===========================================================================*)
  148. (* Add unblocked data yo a converse tasks' input chains                      *)
  149. (*===========================================================================*)
  150.  
  151. PROCEDURE add_c_ub (to_tcb : tcb_ptr; in_place : POINTER; in_cnt : WORD);
  152.  
  153.   VAR
  154.     i           : WORD;
  155.     work_scb    : str_m_chain;
  156.  
  157.   BEGIN;
  158.  
  159.     {$IFDEF POINT_CHK}
  160.       test_pointer(to_tcb);
  161.       test_pointer(in_place);
  162.     {$ENDIF}
  163.  
  164.     (*-----------------------------------------------------------------------*)
  165.     (* Get size of data block needed and the get the block                   *)
  166.     (*-----------------------------------------------------------------------*)
  167.  
  168.     i := in_cnt + str_m_block_oh;
  169.     GETMEM(work_scb, i);
  170.  
  171.     (*-----------------------------------------------------------------------*)
  172.     (* Initialize the fields                                                 *)
  173.     (*-----------------------------------------------------------------------*)
  174.  
  175.     work_scb^.str_m_data.long_length := in_cnt;
  176.     work_scb^.str_m_type             := 1;
  177.  
  178.     (*-----------------------------------------------------------------------*)
  179.     (* Move the data                                                         *)
  180.     (*-----------------------------------------------------------------------*)
  181.  
  182.     MOVE(in_place^, work_scb^.str_m_data.long_data, in_cnt);
  183.  
  184.     (*-----------------------------------------------------------------------*)
  185.     (* Set string length                                                     *)
  186.     (*-----------------------------------------------------------------------*)
  187.  
  188.     IF in_cnt > 255 THEN
  189.       in_cnt := 255;
  190.  
  191.     work_scb^.str_m_data.str_data[0] := CHR(in_cnt);
  192.  
  193.     (*-----------------------------------------------------------------------*)
  194.     (* Chain it on                                                           *)
  195.     (*-----------------------------------------------------------------------*)
  196.  
  197.     add_c_chain(to_tcb, work_scb);
  198.  
  199.   END;
  200.  
  201. (*===========================================================================*)
  202. (* Remove top string from a task's converse input chain                      *)
  203. (*===========================================================================*)
  204.  
  205. PROCEDURE del_c_string(this_tcb : tcb_ptr);
  206.  
  207.   VAR
  208.     i           : WORD;
  209.     work_scb    : str_m_chain;
  210.  
  211.   BEGIN;
  212.  
  213.     work_scb := this_tcb^.c_input;
  214.     IF work_scb = NIL THEN EXIT;
  215.  
  216.     {$IFDEF POINT_CHK}
  217.       test_pointer(this_tcb);
  218.       test_pointer(work_scb);
  219.     {$ENDIF}
  220.  
  221.     this_tcb^.c_input := work_scb^.str_m_next;
  222.  
  223.     i := work_scb^.str_m_data.long_length + str_m_block_oh;
  224.  
  225.     FREEMEM(work_scb, i);
  226.  
  227.     {$IFDEF FREE_CHK}
  228.       test_free_list;
  229.     {$ENDIF}
  230.  
  231.   END;
  232.  
  233. (*===========================================================================*)
  234. (* Drop a conversation                                                       *)
  235. (*===========================================================================*)
  236.  
  237. PROCEDURE drop_conv(this_tcb : tcb_ptr);
  238.  
  239.   VAR
  240.     work_tcb : tcb_ptr;
  241.  
  242.   BEGIN;
  243.  
  244.     {$IFDEF POINT_CHK}
  245.       test_pointer(this_tcb);
  246.     {$ENDIF}
  247.  
  248.     IF this_tcb^.conv_tcb = NIL THEN EXIT;
  249.  
  250.     IF this_tcb^.conv_tcb^.conv_tcb = this_tcb THEN
  251.       this_tcb^.conv_tcb^.conv_tcb := NIL
  252.     ELSE
  253.       BEGIN;
  254.         work_tcb := this_tcb^.conv_tcb;
  255.  
  256.         {$IFDEF POINT_CHK}
  257.           test_pointer(work_tcb);
  258.         {$ENDIF}
  259.  
  260.         WHILE work_tcb^.conv_tcb <> this_tcb DO
  261.           BEGIN;
  262.  
  263.             {$IFDEF POINT_CHK}
  264.               test_pointer(work_tcb);
  265.             {$ENDIF}
  266.  
  267.             work_tcb := work_tcb^.conv_tcb;
  268.  
  269.           END;
  270.  
  271.         {$IFDEF POINT_CHK}
  272.           test_pointer(work_tcb);
  273.         {$ENDIF}
  274.  
  275.         work_tcb^.conv_tcb := this_tcb^.conv_tcb;
  276.       END;
  277.  
  278.     this_tcb^.conv_tcb := NIL;
  279.  
  280.   END;
  281.  
  282. END.
  283.